;(in-package :closer-common-lisp-user)

;;;;;;;;;;;;;;;;;;;;;;
; GLOBAL DEFINITIONS ;
;;;;;;;;;;;;;;;;;;;;;;
;(defvar *local-actor-registry* (make-hash-table))
(defstruct function-call name arguments)
(defstruct message sender receiver function-call future)
(defvar *communication-actor*)
(defvar *discovery-actor*)
(defvar *actor-id* 0)

(defun generate-new-actor-name ()
  (format nil "~d" (incf *actor-id*)))

;;;;;;;;;;;;;;
; SEND macro ;
;;;;;;;;;;;;;;
; (SEND RECEIVER (FUNCTION-NAME FUNCTION-ARGUMENTS))
; Asynchronous function-call
(defmacro send (receiver (name &rest arguments) &optional (future nil futurep))
  `(sendf ,receiver ',name (list ,@arguments) ,@(when futurep `(,future))))

(defun sendf (receiver function-name function-arguments &optional (future (make-instance 'future)))
  (let ((function-call (make-function-call :name function-name :arguments function-arguments)))
    (send-message *current-actor* receiver function-call future)))

;;;;;;;;;;;
; FUTURES ;
;;;;;;;;;;;
; All continuations are executed locally to the sender of the message (same host, same actor).
; TO-THINK: an asynchronous version of the LAMBDA construct
(defclass future (remote-object)
  ((result :accessor future-result)
   (continuations :initform nil :accessor future-continuations)))

(defmethod when-resolved ((resolved-future future) continuation)
  (funcall continuation (future-result resolved-future)))

(defmethod when-resolved :around ((resolved-future future) continuation)
  (if (slot-boundp resolved-future 'result)
      (call-next-method)
    (push continuation (future-continuations resolved-future))))

(defmethod resolve-with-result ((resolved-future future) result)
  (setf (future-result resolved-future) result)
  (loop for continuation in (reverse (future-continuations resolved-future))
        do (funcall continuation result)))

; TO-IMPLEMENT
; (defmethod resolve-with-exception ((resolved-future future) exception))

;;;;;;;;;;
; ACTORS ;
;;;;;;;;;;
(defclass actor-behaviour (remote-object) 
  ((process :initarg :process :accessor actor-behaviour-process)))

;;;;;;;;;;;;;;;;;;;
; MESSAGE SENDING ;
;;;;;;;;;;;;;;;;;;;
; (SEND-MESSAGE ACTOR RECEIVER FUNCTION-CALL)
; Receiver at the same actor
(defmethod send-message ((this-actor actor-behaviour) (receiver remote-object) function-call future)
  (let* ((receiver-actor (remote-object-actor receiver))
         (message (make-message :sender this-actor :receiver receiver
                                :function-call function-call :future future)))
    (receive-message receiver-actor message)
    future))

; Receiver at a differet actor (local or remote)
(defmethod send-message ((this-actor actor-behaviour) (receiver remote-reference) function-call future)
  (let* ((message (make-message :sender this-actor :receiver receiver
                                :function-call function-call :future future)))
    (send *communication-actor* (transmit-message *communication-actor* message) nil)
    future))

; NOTE: There is yet another send-message method definition which specialise over channels.
; See communication file for more details.

;;;;;;;;;;;;;;;;;;;;;;
; MESSAGE RECEPTION  ;
;;;;;;;;;;;;;;;;;;;;;;
; (RECEIVE ACTOR MESSAGE)
; Sender at the same host
(defmethod receive-message ((this-actor actor-behaviour) message)
  (mp:mailbox-send (mp:process-mailbox (actor-behaviour-process this-actor)) message))

;;;;;;;;;;;;;;;;;;;;;;
; MESSAGE PROCESSING ;
;;;;;;;;;;;;;;;;;;;;;;
; (PROCESS ACTOR MESSAGE)
(defmethod process-message ((this-actor actor-behaviour) message)
  (let* ((call (message-function-call message))
         (future (message-future message))
         (result (apply (function-call-name call) (function-call-arguments call))))
    (when (and future result)
      (send future (resolve-with-result future result) nil))))

;;;;;;;;;;;;;;;;;;;;;
; DEFACTOR function ;
;;;;;;;;;;;;;;;;;;;;;
; (MAKE-ACTOR 'my-actor)
(defun make-actor (name &rest objects)
  (let ((actor (make-instance 'actor-behaviour :object-name (format nil "actor-~D-at-~D" name (machine-instance))))
        (mailbox (mp:make-mailbox)))
    (dolist (object objects) (setf (remote-object-actor object) actor))
    (setf (remote-object-actor actor) actor)
    (setf (actor-behaviour-process actor)
          (mp:process-run-function
           (remote-object-name actor)
           (list :mailbox mailbox)
           (lambda ()
             (let ((*current-actor* actor))
               (setf (actor-behaviour-process *current-actor*) mp:*current-process*)
               (loop
                (let ((message (mp:mailbox-read mailbox)))
                  (process-message *current-actor* message)))))))
    actor))

; INITIALISE *current-actor*
(setf *current-actor* (make-actor "default"))
        

